Deutsche Edition 1/Deutsche Edition 1.iso/amok/011-020/amok12/module/inout2.mod

Text File | 1993-11-04 | 7KB | 343 lines

(*---------------------------------------------------------------------------
    :Program.    InOut2.mod
    :Author.     Bernd Preusing
    :Address.    Gerhardstr. 16  D-2200 Elmshorn
    :Phone.      [phone]
    :Shortcut.   [bep]
    :Version.    1.1
    :Date.       09-Nov-88
    :Copyright.  PD
    :Language.   Modula-II
    :Translator. M2Amiga
    :Imports.    Assembler
    :UpDate.     Changed 'count' in ReadCount to VAR, so actual read length
         is returned.
    :Contents.   Added some procedures to InOut
    :Remark.     SetInput und SetOutput dienen dazu, auch Kommandozeilen-
         Parameter direkt zu übergeben und so OpenInput und
         OpenOutput zu umgehen.
         WriteCount, ReadCount sollen FileSystem überflüssig machen.
---------------------------------------------------------------------------*)
IMPLEMENTATION MODULE InOut2;

FROM SYSTEM IMPORT ADR, ADDRESS, BYTE, INLINE, CAST;

FROM ASCII IMPORT
    nul, eof;

FROM Arts IMPORT
    TermProcedure;

FROM Conversions IMPORT
    StrToVal, ValToStr;

IMPORT Dos;

IMPORT Terminal;

FROM Scan IMPORT
    ScanString;


CONST
   RTS = 4E75H;
   msOut = 'out>';
   msIn  = 'in>';

VAR
   InHandle, OutHandle: Dos.FileHandlePtr;


PROCEDURE GetName(VAR str,defExt:ARRAY OF CHAR);
VAR len,pos:INTEGER;
BEGIN
  ScanString(Terminal.Read,str,len,termCh);
  IF (len > 0) AND (str[len-1] = '.') THEN
    pos:=0;
    WHILE (len<=HIGH(str)) AND (pos<=HIGH(defExt)) AND (defExt[pos]#nul) DO
      str[len]:=defExt[pos];
      INC(len);
      INC(pos);
    END;
    str[len]:=nul;
  ELSE
    IF len=0 THEN
      termCh:=nul
    END
  END
END GetName;

PROCEDURE OpenInput(defExt:ARRAY OF CHAR);
VAR str:ARRAY[0..99] OF CHAR;
BEGIN
  Terminal.WriteString(msIn);
  GetName(str,defExt);
  InHandle:=Dos.Open(ADR(str),Dos.oldFile);
  done:=(InHandle#NIL)
END OpenInput;

PROCEDURE OpenOutput(defExt:ARRAY OF CHAR);
VAR str:ARRAY[0..99] OF CHAR;
BEGIN
  Terminal.WriteString(msOut);
  GetName(str,defExt);
  OutHandle:=Dos.Open(ADR(str),Dos.newFile);
  done:=(OutHandle#NIL)
END OpenOutput;

PROCEDURE SetInput(name: ARRAY OF CHAR);
BEGIN
  InHandle:=Dos.Open(ADR(name),Dos.oldFile);
  done:=(InHandle#NIL)
END SetInput;

PROCEDURE SetOutput(name: ARRAY OF CHAR);
BEGIN
  OutHandle:=Dos.Open(ADR(name),Dos.newFile);
  done:=(OutHandle#NIL)
END SetOutput;

PROCEDURE CloseInput();
BEGIN
  IF InHandle#NIL THEN
    Dos.Close(InHandle)
  END;
  InHandle:=NIL;
  done:=TRUE
END CloseInput;

PROCEDURE CloseOutput();
BEGIN
  IF OutHandle#NIL THEN
    Dos.Close(OutHandle)
  END;
  OutHandle:=NIL;
  done:=TRUE
END CloseOutput;

PROCEDURE Write(ch: CHAR);
BEGIN
  IF OutHandle#NIL THEN
    done:= (Dos.Write(OutHandle,ADR(ch),1)=1)
  ELSE
    Terminal.Write(ch);
    done:=TRUE
  END
END Write;

PROCEDURE WriteBytes(VAR blk: ARRAY OF BYTE);
BEGIN
  IF OutHandle#NIL THEN
    done:= (Dos.Write(OutHandle,ADR(blk),HIGH(blk)+1) =HIGH(blk)+1)
  ELSE
    done:=FALSE
  END
END WriteBytes;

PROCEDURE WriteCount(adr: ADDRESS; count: LONGINT);
BEGIN
  IF OutHandle#NIL THEN
    done:= (Dos.Write(OutHandle,adr,count) =count)
  ELSE
    done:=FALSE
  END
END WriteCount;

PROCEDURE WriteString(str: ARRAY OF CHAR);
VAR len:LONGINT;
BEGIN
  IF OutHandle#NIL THEN
    len:=0;
    WHILE (len<=HIGH(str)) AND (str[len]#nul) DO
      INC(len)
    END;
    done:= (Dos.Write(OutHandle,ADR(str),len)=len)
  ELSE
    Terminal.WriteString(str);
    done:=TRUE
  END
END WriteString;

(* $E- *) (* geht nur, weil keine Parameter und keine Lokalvariablen! *)
PROCEDURE WriteLn();
BEGIN
  Write(eol);
  INLINE(RTS)
END WriteLn;

PROCEDURE Read(VAR ch: CHAR);
BEGIN
  IF InHandle#NIL THEN
    IF Dos.Read(InHandle,ADR(ch),1)#1 THEN
      ch:=eof (* Ctrl-\ *)
    END;
  ELSE
    Terminal.Read(ch)
  END;
  done:=TRUE
END Read;

PROCEDURE ReadBytes(VAR blk: ARRAY OF BYTE);
BEGIN
  IF InHandle#NIL THEN
    done:=(Dos.Read(InHandle,ADR(blk),HIGH(blk)+1) = HIGH(blk)+1)
  ELSE
    done:=FALSE
  END;
END ReadBytes;

PROCEDURE ReadCount(adr: ADDRESS; VAR count: LONGINT);
VAR IsCount: LONGINT;
BEGIN
  IF InHandle#NIL THEN
    IsCount:=Dos.Read(InHandle,adr,count);
    done:= (IsCount = count);
    count:=IsCount
  ELSE
    done:=FALSE
  END;
END ReadCount;

PROCEDURE ReadString(VAR str: ARRAY OF CHAR);
VAR len: INTEGER;
BEGIN
  ScanString(Read,str,len,termCh);
  done:=(len#0)
END ReadString;

PROCEDURE ReadLn(VAR str: ARRAY OF CHAR; VAR len: INTEGER);
TYPE CharPtr = POINTER TO CHAR;
VAR Pos, i, actlen: LONGINT;
    cp: CharPtr;
BEGIN
  IF InHandle#NIL THEN
    Pos:=Dos.Seek(InHandle,0,Dos.current); (* Zeilenanfang merken *)
    actlen:=Dos.Read(InHandle,ADR(str),HIGH(str)+1); (* soviel wie möglich *)
    IF actlen<=0 THEN
      done:=FALSE;
      termCh:=eof;
      len:=0;
      str[0]:=nul
    ELSE
      i:=0; (* $V- $R- *)
      cp:=CAST(CharPtr,ADR(str));
      WHILE (i<actlen) AND (cp^#eol) DO INC(i); INC(cp) END;
      IF i<actlen THEN (* ist eol *)
        cp^:=nul;
        termCh:=eol
      ELSE
        termCh:=cp^; (* kein Zeilenende erreicht *)
      END;
      (* $V= $R= *)
      Pos:=Dos.Seek(InHandle,Pos+i+1,Dos.beginning); (* auf nächste Zeile *)
      len:=i;
      done:=TRUE;
    END;
  ELSE
    Terminal.ReadLn(str,len);
    termCh:=eol;
    done:=TRUE
  END;
END ReadLn;

PROCEDURE WriteInt(x: LONGINT; n: INTEGER);
VAR str: ARRAY[0..99] OF CHAR;
BEGIN
  ValToStr(x,TRUE,str,10,n,' ',done);
  done:=NOT done; (* kein error *)
  IF done THEN
    WriteString(str)
  END
END WriteInt;

PROCEDURE WriteCard(x: LONGCARD; n: INTEGER);
VAR str: ARRAY[0..99] OF CHAR;
BEGIN
  ValToStr(CAST(LONGINT,x),FALSE,str,10,n,' ',done);
  done:=NOT done; (* kein error *)
  IF done THEN
    WriteString(str)
  END
END WriteCard;

PROCEDURE WriteOct(x: LONGINT; n: INTEGER);
VAR str: ARRAY[0..99] OF CHAR;
BEGIN
  ValToStr(x,FALSE,str,8,n,'0',done);
  done:=NOT done; (* kein error *)
  IF done THEN
    WriteString(str)
  END
END WriteOct;

PROCEDURE WriteHex(x: LONGINT; n: INTEGER);
VAR str: ARRAY[0..99] OF CHAR;
BEGIN
  ValToStr(x,FALSE,str,16,n,'0',done);
  done:=NOT done; (* kein error *)
  IF done THEN
    WriteString(str)
  END
END WriteHex;

PROCEDURE ReadInt(VAR x: INTEGER);
VAR str: ARRAY[0..99] OF CHAR;
    l:LONGINT;
    signed: BOOLEAN;
BEGIN
  ReadString(str);
  StrToVal(str,l,signed,10,done);
  done:= (NOT done) AND (signed AND (l>= MIN(INTEGER)) OR
          (CAST(LONGCARD,l)<= CAST(LONGCARD,MAX(INTEGER))));
  IF done THEN
    x:=l
  END;
END ReadInt;

PROCEDURE ReadCard(VAR x: CARDINAL);
VAR str: ARRAY[0..99] OF CHAR;
    l:LONGINT;
    signed: BOOLEAN;
BEGIN
  ReadString(str);
  StrToVal(str,l,signed,10,done);
  done:= (NOT done) AND (CAST(LONGCARD,l)<=MAX(CARDINAL));
  IF done THEN
    x:=CARDINAL(l)
  END;
END ReadCard;

PROCEDURE ReadLongInt(VAR x: LONGINT);
VAR str: ARRAY[0..99] OF CHAR;
    signed: BOOLEAN;
BEGIN
  ReadString(str);
  StrToVal(str,x,signed,10,done);
  done:= (NOT done) AND (signed OR (x>=0));
END ReadLongInt;

PROCEDURE ReadLongCard(VAR x: LONGCARD);
VAR str: ARRAY[0..99] OF CHAR;
    l:LONGINT;
    signed: BOOLEAN;
BEGIN
  ReadString(str);
  StrToVal(str,l,signed,10,done);
  done:= (NOT done) AND (NOT signed);
  IF done THEN
    x:=CAST(LONGCARD,l)
  END;
END ReadLongCard;

PROCEDURE Cleanup();
BEGIN
  CloseInput;
  CloseOutput
END Cleanup;

BEGIN
  InHandle:=NIL;
  OutHandle:=NIL;
  TermProcedure(Cleanup)
END InOut2.mod